#------------------------------------------------------------------------------

#  读取消费过的会员信息：rawdata
data<-rawdata

# 定义分类变量和数值变量
factor.names<-names(data)[!(sapply(data,class) %in% c('numeric','interger'))]
vector.names<-names(data)[sapply(data,class) %in% c('numeric','interger')]

# 数据初步整理

data$memberid<-data$MemberID<-data$Birthday<-data$email<-NULL

data<-data[outlier.delete(data[,vector.names]),]

# 缺失值处理
data<-lossdelete(data)
lossrate(data)

# add.miss 自定义插补数值型变量
num
data<-add.miss(data,names(data)[lossrate(data)>0],num)

# 分类变量处理
data$cardstatus<-factor(data$cardstatus,levels=c("删除","挂失","注销","停用","过期","初始","休眠","在用"),labels=letters[1:8])
data$sourcechannel<-factor(data$sourcechannel,levels=c("其它","航空公司","银行","总部财务","总部中央","门店","网上售卡","网络会员","市场活动","其它市场活动"),labels=letters[1:10])
data$rnature<-factor(data$rnature,levels=c("免费","折扣","原价"),labels=c('Free','Discount','Full'))
data$levelchangereason<-factor(data$levelchangereason,levels=c("NULL","授权降级","授权升级","活动","积分升级","购买升级"),labels=c('NULL','Down','Up','Act up','Point up','Buy up'))
data$levelchangereason[is.na(data$levelchangereason)]<-"NULL"
data$rmode<-factor(data$rmode,levels=c("PMS","系统后台","门店Pad","iPad","电话","短信","WindowsPhone","Android","iPhone","WAP","WEB注册"),labels=c("WebPMS","CRM","H_Pad","Ipad","CRS","SMS","WindowsPhone","Android","IPhone","WAP","WebSite"))
data$gender<-factor(data$gender,levels=c("男","未知","女"),labels=c('M',"X","F"))


# 数据集划分
sleep<-data[data$status=='sleep',]
inactive<-data[data$status=='inactive',]
sleep$status<-inactive$status<-NULL

# 训练模型
library(nnet)

fields<-c(names(inactive)[grep('ecoupon',names(inactive))],'ecoupon')
inactive.ecoupon<-Jihuo(inactive[,fields],'ecoupon')

fields<-c(names(inactive)[grep('value',names(inactive))],'value')
inactive.value<-Jihuo(inactive[,fields],'value')

fields<-c(names(sleep)[grep('ecoupon',names(sleep))],'ecoupon')
sleep.ecoupon<-Jihuo(sleep[,fields],'ecoupon')

fields<-c(names(sleep)[grep('point',names(sleep))],'point')
sleep.point<-Jihuo(sleep[,fields],'point')

fields<-c(names(sleep)[grep('value',names(sleep))],'value')
sleep.value<-Jihuo(sleep[,fields],'value')

# 模型评价
model.res<-list()
for (i in c('inactive.ecoupon','inactive.value','sleep.ecoupon','sleep.point','sleep.value')){
  model.res[[i]]<-model.evaluation(sapply(strsplit(i,split="[.]"),"[",1),sapply(strsplit(i,split="[.]"),"[",2),i)  
}

rm(list=ls()[!(ls() %in% c('inactive.ecoupon','inactive.value','sleep.ecoupon','sleep.point','sleep.value',"rawdata"))])












#==================================================================================
#==================================================================================
#   Appendix (Functions)
#==================================================================================
#==================================================================================

#---查看缺失率,删除缺失率高的字段
lossrate<-function(x){
  a<-apply(is.na(x),2,mean)
  a<-round(a,3)
  return(a)
}

lossdelete<-function(x){
  a<-apply(is.na(x),2,mean)
  a<-round(a,3)
  deletecols<-names(a[a>0.8])
  deleterows<-names(a[a>0&a<0.2])
  for(i in deletecols){
    x[,i]<-NULL
  }
  for(j in deleterows){
    x<-x[!is.na(x[,j]),]  
  }
  return(x)
}

#---分类型变量数据集，相关性分析
cor.factor<-function(data){
  n<-names(data)
  cor<-NULL
  p<-NULL
  for(i in n){
    for(j in n){
      newdata<-na.omit(data[,c(i,j)])
      chisq<-chisq.test(table(newdata[,1],newdata[,2]))
      cor<-c(cor,chisq[[1]])
      p<-c(p,chisq[[3]]>0.05)
    }
  }
  cor[p]<-0
  cor<-matrix(cor,nrow=length(n))
  colnames(cor)<-n
  rownames(cor)<-n
  return(cor)
}


#---删除没有意义的字段
valid.data<-function(data){
  invalid<-na.omit(names(data)[sapply(data,sd,na.rm=T)==0])
  valid<-setdiff(names(data),invalid)
  data<-data[,valid]
  return(data)
}


#---插补缺失值
add.miss<-function(data,col,num){
  if(length(col)==1){
    i=col
    data[is.na(data[,i]),i]<-num
  }
  else{
    for(i in col){
      data[is.na(data[,i]),i]<-num[i]
    }
  }
  return(data)
}

#---oneway 方差分析
fc.test<-function(factor,varible,data){
  fc=NULL
  for(i in factor){
    for(j in varible){
      formula=as.formula(paste(j,"~",i))
      fc=c(fc,oneway.test(formula,data=data,var.equal = TRUE)$p.value<0.05)
    }
  }
  fc=matrix(fc,nrow=length(varible),ncol=length(factor),byrow=F,dimnames=list(varible,factor))
  return(fc)
}

#---创建平衡样本
data.balance<-function(data,v,vlevels,num){
  id=NULL
  for(i in vlevels){
    N<-which(data[,v]==i)
    nsample<-sample(c(1:length(N)),num[i],replace=T)
    id<-c(id,N[nsample])
  }
  newdata<-data[id,]
  return(newdata)
}

#---分类型变量数据集，相关性分析
cor.factor<-function(data){
  n<-names(data)
  cor<-NULL
  p<-NULL
  for(i in n){
    for(j in n){
      newdata<-na.omit(data[,c(i,j)])
      chisq<-chisq.test(table(newdata[,1],newdata[,2]))
      cor<-c(cor,chisq[[1]])
      p<-c(p,chisq[[3]]>0.05)
    }
  }
  cor[p]<-0
  cor<-matrix(cor,nrow=length(n))
  colnames(cor)<-n
  rownames(cor)<-n
  return(cor)
}

#---异常值处理

outlier.delete<-function(data){
  ks<-sapply(data,function(x) ks.test(x+runif(length(x),-0.01,0.01),"pnorm",mean(x),sd(x))$p.value)
  mean<-sapply(data,mean,na.rm=T)
  sd<-sapply(data,sd,na.rm=T)
  Q1<-sapply(data,quantile,0.25,na.rm=T)
  Q3<-sapply(data,quantile,0.75,na.rm=T)
  QR<-Q3-Q1
  
  outlier<-apply(data[,ks<0.05],1,function(x) mean(x>Q1[ks<0.05]-3*QR[ks<0.05] & x<Q3[ks<0.05]+3*QR[ks<0.05],na.rm=T))
  newID<-rownames(data)[outlier>quantile(outlier,0.2)]
  
  if (sum(ks>0.05)>0){
    outlier<-apply(data[,ks>0.05],1,function(x) mean(x>mean[ks>0.05]-3*sd[ks>0.05] & x<mean[ks>0.05]+3*sd[ks>0.05],na.rm=T))  
    newID<-rownames(data)[outlier>quantile(outlier,0.2)]
  }
  return(newID)  
}

#---模型训练

train.model<-function(traindata,formula,times,testdata){
  model<-list()
  for(i in 1:times){
    for(n in 3:9){
      x=x+1
      nnet<-nnet(formula,data=traindata,size= n ,rang=0.3,maxit=150,Hess=T)
      testpre<-predict(nnet,testdata,type='class')
      testpre[is.na(testpre)]<-0
      zq<-sum(testpre==testdata$response)/nrow(testdata)
      model[[x]]<-list(value=zq,model=nnet)  
    }  
  } 
  return(model)
}

Jihuo<-function(data,vector){
  # 建训练样本
  sampleid<-sample(1:nrow(data),round(nrow(data)*0.8,0))
  traindata<-data[sampleid,]
  testdata<-data[-sampleid,]
  # 指导字段
  data$response<-'Y'
  data$response[data$vector==0,]<-'N'
  data$response<-as.factor(data$response)
  data$vector<-NULL
  
  formula<-as.formula("response~.")
  
  # 模型训练
  model<-train.model(traindata,formula,20,testdata)
  
  x<-which(sapply(model,function(x) x$value)==max(sapply(model,function(x) x$value)))[1]
  
  model.nnet<-model[[n]]$model
  
  return(model.nnet)
}

#---模型评价

model.evaluation<-function(data,response,model){
  testpre<-predict(model,data,type='class')
  testpretable<-table(data$response,testpre)
  accuracy<-length(which(data$response==testpre))/nrow(data)
  target.accuracy<-testpretable['5','5']/sum(testpretable['5',])
  target.recall<-testpretable['5','5']/sum(testpretable[,'5'])
  return(c(accuracy,target.accuracy,target.recall,accuracy*target.accuracy*target.recall))
}
